home *** CD-ROM | disk | FTP | other *** search
/ 3D GFX / 3D GFX.iso / amiutils / i_l / irit5 / irit / inptevl3.c < prev    next >
C/C++ Source or Header  |  1995-12-30  |  38KB  |  1,034 lines
  1. /*****************************************************************************
  2. *   "Irit" - the 3d (not only polygonal) solid modeller.             *
  3. *                                         *
  4. * Written by:  Gershon Elber                Ver 0.2, Mar. 1990   *
  5. ******************************************************************************
  6. *   Module to evaluate the binary tree generated by the InptPrsr module.     *
  7. *   All the objects are handled the same but the numerical one, which is     *
  8. * moved as a RealType and not as an object (only internally within this         *
  9. * module) as it is frequently used and consumes much less memory this way.   *
  10. *   Note this module is par of InptPrsr module and was splited only because  *
  11. * of text file sizes problems...                         *
  12. *****************************************************************************/
  13.  
  14. #include <stdio.h>
  15. #include <ctype.h>
  16. #include <math.h>
  17. #include <string.h>
  18. #include "program.h"
  19. #include "ctrl-brk.h"
  20. #include "objects.h"
  21. #include "allocate.h"
  22. #include "inptprsg.h"
  23. #include "inptprsl.h"
  24. #include "windows.h"
  25.  
  26. static int
  27.     GlblDebugFuncLevel = 0;
  28.  
  29. static void RebindVariable(ParseTree *Root, IPObjectStruct *PObj, int FreeOld);
  30. static ParseTree *InptEvalFetchExpression(ParseTree *Root, int i, int n);
  31. static int InptEvalCountNumExpressions(ParseTree *Root);
  32. static void InptEvalDeleteFunc(UserDefinedFuncDefType *UserFunc,
  33.                    int DeleteSelf);
  34.  
  35. /*****************************************************************************
  36. * DESCRIPTION:                                                               M
  37. * Prints help on the given subject HelpHeader.                     M
  38. *   A match is if the HelpHeader isa prefix of help file line.             M
  39. *                                                                            *
  40. * PARAMETERS:                                                                M
  41. *   HelpHeader:   Subject of help needed.                                    M
  42. *                                                                            *
  43. * RETURN VALUE:                                                              M
  44. *   void                                                                     M
  45. *                                                                            *
  46. * KEYWORDS:                                                                  M
  47. *   InptEvalPrintHelp                                                        M
  48. *****************************************************************************/
  49. void InptEvalPrintHelp(char *HelpHeader)
  50. {
  51.     static char
  52.     *DefaultHelp = NULL;
  53.     int    i;
  54.     char *Path, s[LINE_LEN];
  55.     FILE *f;
  56.  
  57.     Path = searchpath(GlblHelpFileName);
  58.  
  59.     if (DefaultHelp == NULL)
  60.     DefaultHelp = IritStrdup("Commands");
  61.  
  62.     if (strlen(HelpHeader) == 0)
  63.     HelpHeader = DefaultHelp;        /* Print a list of all commands. */
  64.  
  65.     if ((f = fopen(Path, "r")) == NULL) {
  66.     sprintf(s, "Cannot open help file \"%s\".\n", GlblHelpFileName);
  67.     WndwInputWindowPutStr(s);
  68.     return;
  69.     }
  70.  
  71.     for (i = 0; i < (int) strlen(HelpHeader); i++)
  72.     if (islower(HelpHeader[i]))
  73.         HelpHeader[i] = toupper(HelpHeader[i]);
  74.  
  75.     while (fgets(s, LINE_LEN-1, f) != NULL) {
  76.     if (strncmp(HelpHeader, s, strlen(HelpHeader)) == 0) {
  77.         /* Found match - print it. */
  78.         while (fgets(s, LINE_LEN-1, f) != NULL && s[0] != '$') {
  79.         if (s[strlen(s) - 1] < ' ')
  80.             s[strlen(s) - 1] = 0;            /* No CR/LF. */
  81.  
  82.         WndwInputWindowPutStr(&s[1]);             /* Skip char 1. */
  83.         }
  84.         fclose(f);
  85.         return;
  86.     }
  87.     }
  88.  
  89.     fclose(f);
  90.  
  91.     sprintf(s, "No help on %s\n", HelpHeader);
  92.     WndwInputWindowPutStr(s);
  93. }
  94.  
  95. /*****************************************************************************
  96. * DESCRIPTION:                                                               M
  97. * Compares two objects with comparison operator as in Root.             M
  98. *                                                                            *
  99. * PARAMETERS:                                                                M
  100. *   Root:         Type of comparison requested (=, <, >, etc.).              M
  101. *   Left, Right:  Two objects to compare.                                    M
  102. *   IError:       Type of error if was one.                                  M
  103. *   CError:       Description of error if was one.                           M
  104. *                                                                            *
  105. * RETURN VALUE:                                                              M
  106. *   ParseTree *:  Comparison result as a numeric value of >0, 0, <0.         M
  107. *                                                                            *
  108. * KEYWORDS:                                                                  M
  109. *   InptEvalCompareObject                                                    M
  110. *****************************************************************************/
  111. ParseTree *InptEvalCompareObject(ParseTree *Root,
  112.                  ParseTree *Left,
  113.                  ParseTree *Right,
  114.                  InptPrsrEvalErrType *IError,
  115.                  char *CError)
  116. {
  117.     int OnlyEquality = TRUE;
  118.     RealType
  119.     Cmp = 0.0;
  120.  
  121.     if (Left -> PObj -> ObjType != Right -> PObj -> ObjType) {
  122.     *IError = IE_ERR_INCOMPARABLE_TYPES;
  123.     strcpy(CError, "");
  124.     return NULL;
  125.     }
  126.  
  127.     switch (Left -> PObj -> ObjType) {
  128.     case IP_OBJ_NUMERIC:
  129.         Cmp = SIGN(Left -> PObj -> U.R - Right -> PObj -> U.R);
  130.         OnlyEquality = FALSE;
  131.         break;
  132.     case IP_OBJ_POINT:
  133.         Cmp = PT_APX_EQ(Left -> PObj -> U.Pt,
  134.                 Right -> PObj -> U.Pt) == 0;
  135.         break;
  136.     case IP_OBJ_VECTOR:
  137.         Cmp = PT_APX_EQ(Left -> PObj -> U.Vec,
  138.                 Right -> PObj -> U.Vec) == 0;
  139.         break;
  140.     case IP_OBJ_PLANE:
  141.         Cmp =  PLANE_APX_EQ(Left -> PObj -> U.Plane,
  142.                 Right -> PObj -> U.Plane) == 0;
  143.         break;
  144.     case IP_OBJ_STRING:
  145.         Cmp = strcmp(Left -> PObj -> U.Str, Right -> PObj -> U.Str);
  146.         OnlyEquality = FALSE;
  147.         break;
  148.     default:
  149.         break;
  150.     }
  151.  
  152.     switch (Root -> NodeKind) {
  153.     case CMP_EQUAL:
  154.         Cmp = Cmp == 0.0;
  155.         break;
  156.     case CMP_NOTEQUAL:
  157.         Cmp = Cmp != 0.0;
  158.         break;
  159.     case CMP_LSEQUAL:
  160.     case CMP_GTEQUAL:
  161.     case CMP_LESS:
  162.     case CMP_GREAT:
  163.         if (OnlyEquality) {
  164.         *IError = IE_ERR_ONLYEQUALITY_TEST;
  165.         strcpy(CError, "");
  166.         return NULL;
  167.         }
  168.         else {
  169.         switch (Root -> NodeKind) {
  170.             case CMP_LSEQUAL:
  171.                 Cmp = Cmp <= 0.0;
  172.                 break;
  173.             case CMP_GTEQUAL:
  174.                 Cmp = Cmp >= 0.0;
  175.             break;
  176.             case CMP_LESS:
  177.                 Cmp = Cmp < 0.0;
  178.             break;
  179.             case CMP_GREAT:
  180.                 Cmp = Cmp > 0.0;
  181.             break;
  182.         }
  183.         }
  184.         break;
  185.     default:
  186.         IritFatalError("A comparison operator expected.");
  187.         break;
  188.     }
  189.  
  190.     Root -> PObj = GenNUMValObject(Cmp);
  191.     return Root;
  192. }
  193.  
  194. /*****************************************************************************
  195. * DESCRIPTION:                                                               M
  196. * Executes the IF expression.                                                M
  197. *                                                                            *
  198. * PARAMETERS:                                                                M
  199. *   Cond:        To evaluate in the IF sentence.                             M
  200. *   CondTrue:    Optional, execute if Cond is TRUE.                          M
  201. *   CondFalse:   Optional, execute if Cond is FALSE.                         M
  202. *                                                                            *
  203. * RETURN VALUE:                                                              M
  204. *   void                                                                     M
  205. *                                                                            *
  206. * KEYWORDS:                                                                  M
  207. *   InptEvalIfCondition                                                      M
  208. *****************************************************************************/
  209. void InptEvalIfCondition(ParseTree *Cond,
  210.              ParseTree *CondTrue,
  211.              ParseTree *CondFalse)
  212. {
  213.     if ((Cond = InptPrsrEvalTree(Cond, 1)) != NULL &&
  214.     Cond -> PObj != NULL &&
  215.     IP_IS_NUM_OBJ(Cond -> PObj)) {
  216.     if (APX_EQ(Cond -> PObj -> U.R, 0.0)) {
  217.         if (CondFalse != NULL)
  218.           InptPrsrEvalTree(CondFalse, 0);
  219.     }
  220.     else {
  221.         if (CondTrue != NULL)
  222.         InptPrsrEvalTree(CondTrue, 0);
  223.     }
  224.     }
  225.     else {
  226.     IPGlblEvalError = IE_ERR_IF_HAS_NO_COND;
  227.     strcpy(IPGlblCharData, "");
  228.     }
  229. }
  230.  
  231. /*****************************************************************************
  232. * DESCRIPTION:                                                               M
  233. * Executes the FOR expression loop.                         M
  234. *   As InptPrsrEvalTree routine is destructive on its input tree, we must    M
  235. * make a copy of the body before executing it!                          M
  236. *   We wish we could access the loop variable directly, but the user might   M
  237. * free them in the loop - so me must access it by name.                 M
  238. *                                                                            *
  239. * PARAMETERS:                                                                M
  240. *   PStart:    Initailization expression.                                    M
  241. *   PInc:      Increment expression.                                         M
  242. *   PEnd:      Termination expression.                                       M
  243. *   PBody:     Body of loop expression.                                      M
  244. *                                                                            *
  245. * RETURN VALUE:                                                              M
  246. *   void                                                                     M
  247. *                                                                            *
  248. * KEYWORDS:                                                                  M
  249. *   InptEvalForLoop                                                          M
  250. *****************************************************************************/
  251. void InptEvalForLoop(ParseTree *PStart,
  252.              ParseTree *PInc,
  253.              ParseTree *PEnd,
  254.              ParseTree *PBody)
  255. {
  256.     int i, NumOfExpr, LoopCount;
  257.     char
  258.     *LoopVarName = NULL;
  259.     RealType LoopVar, StartVal, Increment, EndVal;
  260.     ParseTree *PTemp;
  261.     IPObjectStruct *PLoopVar;
  262.  
  263.     /* Find the only two cases where loop variable is allowed - when then */
  264.     /* given starting value is a parameter, or assignment to parameter... */
  265.     if (PStart -> NodeKind == PARAMETER)
  266.     LoopVarName = PStart -> PObj -> Name;
  267.     else if (PStart -> NodeKind == EQUAL &&
  268.          PStart -> Left -> NodeKind == PARAMETER) {
  269.     LoopVarName = PStart -> Left -> PObj -> Name;
  270.     /* Rebind the iteration variable to body - it might be new: */
  271.     RebindVariable(PBody, PStart -> Left -> PObj, FALSE);
  272.     if (GetObject(LoopVarName) == NULL)        /* It is really new. */
  273.         PStart -> Left -> PObj -> Count++;
  274.     }
  275.  
  276.     PStart = InptPrsrEvalTree(PStart, 1);     /* Evaluate starting value. */
  277.     PInc   = InptPrsrEvalTree(PInc, 1);        /* Evaluate increment value. */
  278.     PEnd   = InptPrsrEvalTree(PEnd, 1);              /* Evaluate end value. */
  279.     if (IPGlblEvalError ||
  280.     PStart == NULL || PInc == NULL || PEnd == NULL)
  281.     return;
  282.     StartVal = PStart -> PObj -> U.R;
  283.     Increment = PInc -> PObj -> U.R;
  284.     EndVal = PEnd -> PObj -> U.R;
  285.  
  286.     /* Num. of expr. in the body. */
  287.     NumOfExpr = InptEvalCountNumExpressions(PBody);
  288.     for (LoopVar = StartVal, LoopCount = 0;
  289.     APX_EQ(LoopVar, EndVal) ||
  290.     (Increment > 0 ? LoopVar <= EndVal : LoopVar >= EndVal);
  291.     LoopVar += Increment, LoopCount++) {
  292.     if (IPGlblEvalError || GlblFatalError)
  293.         return;
  294.     if (LoopVarName != NULL) {
  295.         if ((PLoopVar = GetObject(LoopVarName)) != NULL &&
  296.         IP_IS_NUM_OBJ(PLoopVar))
  297.         PLoopVar -> U.R = LoopVar;         /* Update loop var. */
  298.         else {
  299.         IPGlblEvalError = IE_ERR_MODIF_ITER_VAR;
  300.         strcpy(IPGlblCharData, LoopVarName);
  301.         }
  302.     }
  303.  
  304.     for (i = 0; i < NumOfExpr; i++) {
  305.         PTemp = InptEvalFetchExpression(PBody, i, NumOfExpr);
  306.         if (LoopCount == 0 && InptPrsrTypeCheck(PTemp, 0) == ERROR_EXPR)
  307.         return;
  308.         else {
  309.         if (LoopVar == EndVal) {
  310.             /* Use the original tree. Note we must evaluate the      */
  311.             /* original tree at least once as ObjType's are updated. */
  312.             InptPrsrEvalTree(PTemp, 0);     /* Eval as its top level... */
  313.         }
  314.         else {
  315.             PTemp = InptPrsrCopyTree(PTemp);
  316.             InptPrsrEvalTree(PTemp, 0);     /* Eval as its top level... */
  317.             InptPrsrFreeTree(PTemp);         /* Not needed any more. */
  318.         }
  319.         }
  320.     }
  321.     }
  322. }
  323.  
  324. /*****************************************************************************
  325. * DESCRIPTION:                                                               *
  326. * Rebinds a variable - given a tree, scan it and update each occurance of    *
  327. * that variable to point to PObj.                         *
  328. *                                                                            *
  329. * PARAMETERS:                                                                *
  330. *   Root:        Tree to rebind.                                             *
  331. *   PObj:        Variable to rebind to.                                      *
  332. *   FreeOld:     Should we free old instance of PObj?                        *
  333. *                                                                            *
  334. * RETURN VALUE:                                                              *
  335. *   void                                                                     *
  336. *****************************************************************************/
  337. static void RebindVariable(ParseTree *Root, IPObjectStruct *PObj, int FreeOld)
  338. {
  339.     if (Root == NULL)
  340.     return;
  341.  
  342.     if (IS_FUNCTION(Root -> NodeKind)) {           /* All the functions. */
  343.     RebindVariable(Root -> Right, PObj, FreeOld);
  344.     return;
  345.     }
  346.  
  347.     switch (Root -> NodeKind) {
  348.     case DIV:
  349.     case MINUS:
  350.     case MULT:
  351.     case PLUS:
  352.     case POWER:
  353.  
  354.     case COMMA:
  355.     case COLON:
  356.     case EQUAL:
  357.     case CMP_EQUAL:
  358.     case CMP_NOTEQUAL:
  359.     case CMP_LSEQUAL:
  360.     case CMP_GTEQUAL:
  361.     case CMP_LESS:
  362.     case CMP_GREAT:
  363.     case BOOL_OR:
  364.     case BOOL_AND:
  365.         RebindVariable(Root -> Right, PObj, FreeOld);
  366.         RebindVariable(Root -> Left, PObj, FreeOld);
  367.         return;
  368.  
  369.     case UNARMINUS:
  370.     case BOOL_NOT:
  371.         RebindVariable(Root -> Right, PObj, FreeOld);
  372.         return;
  373.  
  374.     case NUMBER:
  375.         return;
  376.  
  377.     case PARAMETER:
  378.     case STRING:
  379.         if (strcmp(Root -> PObj -> Name, PObj -> Name) == 0) {
  380.         if (FreeOld && IP_IS_UNDEF_OBJ(Root -> PObj))
  381.             IPFreeObject(Root -> PObj);
  382.         Root -> PObj = PObj;
  383.         }
  384.             return;
  385.  
  386.     case TOKENSTART:
  387.         return;
  388.  
  389.     default:
  390.         IritFatalError("RebindVariable: Undefined ParseTree type, exit");
  391.     }
  392. }
  393.  
  394. /*****************************************************************************
  395. * DESCRIPTION:                                                               M
  396. * Marks all undefined objects in bindings as "to be assigned".               M
  397. *                                                                            *
  398. * PARAMETERS:                                                                M
  399. *   Root:        Tree to rebind.                                             M
  400. *                                                                            *
  401. * RETURN VALUE:                                                              M
  402. *   void                                                                     M
  403. *                                                                            *
  404. * KEYWORDS:                                                                  M
  405. *   IritPrsrMarkToBeAssigned                                                 M
  406. *****************************************************************************/
  407. void IritPrsrMarkToBeAssigned(ParseTree *Root)
  408. {
  409.     if (Root == NULL)
  410.     return;
  411.  
  412.     if (IS_FUNCTION(Root -> NodeKind)) {           /* All the functions. */
  413.     IritPrsrMarkToBeAssigned(Root -> Right);
  414.     return;
  415.     }
  416.  
  417.     switch (Root -> NodeKind) {
  418.     case DIV:
  419.     case MINUS:
  420.     case MULT:
  421.     case PLUS:
  422.     case POWER:
  423.  
  424.     case COMMA:
  425.     case COLON:
  426.     case EQUAL:
  427.     case CMP_EQUAL:
  428.     case CMP_NOTEQUAL:
  429.     case CMP_LSEQUAL:
  430.     case CMP_GTEQUAL:
  431.     case CMP_LESS:
  432.     case CMP_GREAT:
  433.     case BOOL_OR:
  434.     case BOOL_AND:
  435.         IritPrsrMarkToBeAssigned(Root -> Right);
  436.         IritPrsrMarkToBeAssigned(Root -> Left);
  437.         return;
  438.  
  439.     case UNARMINUS:
  440.     case BOOL_NOT:
  441.         IritPrsrMarkToBeAssigned(Root -> Right);
  442.         return;
  443.  
  444.     case NUMBER:
  445.     case STRING:
  446.         return;
  447.  
  448.     case PARAMETER:
  449.         if (IP_IS_UNDEF_OBJ(Root -> PObj))
  450.         SET_TO_BE_ASSIGN_OBJ(Root -> PObj);
  451.             return;
  452.  
  453.     case TOKENSTART:
  454.         return;
  455.  
  456.     default:
  457.         IritFatalError("IritPrsrMarkToBeAssigned: Undefined ParseTree type, exit");
  458.     }
  459. }
  460.  
  461. /*****************************************************************************
  462. * DESCRIPTION:                                                               M
  463. * Creates an OBJECT LIST object out of all parameters.                       M
  464. *                                                                            *
  465. * PARAMETERS:                                                                M
  466. *   PObjParams:     To insert into one list object.                          M
  467. *                                                                            *
  468. * RETURN VALUE:                                                              M
  469. *   IPObjectStruct *:  A list object with all the parameters, or NULL if     M
  470. *               error.                             M
  471. *                                                                            *
  472. * KEYWORDS:                                                                  M
  473. *   InptEvalGenObjectList                                                    M
  474. *****************************************************************************/
  475. IPObjectStruct *InptEvalGenObjectList(ParseTree *PObjParams)
  476. {
  477.     int i, NumOfParams;
  478.     ParseTree *Param;
  479.     IPObjectStruct *PObj;
  480.  
  481.     NumOfParams = InptEvalCountNumParameters(PObjParams);
  482.  
  483.     PObj = IPAllocObject("", IP_OBJ_LIST_OBJ, NULL);
  484.  
  485.     for (i = 0; i < NumOfParams; i++) {
  486.     if ((Param = InptPrsrEvalTree(InptEvalFetchParameter(PObjParams, i,
  487.                                  NumOfParams),
  488.                       1)) == NULL) {
  489.         IPFreeObject(PObj);
  490.         return NULL;
  491.         }
  492.  
  493.     if (IP_IS_UNDEF_OBJ(Param -> PObj)) {
  494.         IPGlblEvalError = IE_ERR_IP_OBJ_UNDEFINED;
  495.         strcpy(IPGlblCharData, Param -> PObj -> Name);
  496.         ListObjectInsert(PObj, i, NULL);
  497.         IPFreeObject(PObj);
  498.         return NULL;
  499.     }
  500.  
  501.     ListObjectInsert(PObj, i, Param -> PObj);
  502.     Param -> PObj -> Count++;    /* Increase number of references. */
  503.     }
  504.  
  505.     ListObjectInsert(PObj, NumOfParams, NULL);
  506.  
  507.     return PObj;
  508. }
  509.  
  510. /*****************************************************************************
  511. * DESCRIPTION:                                                               M
  512. * Creates a Control Point Object out of all parameters.                 M
  513. *                                                                            *
  514. * PARAMETERS:                                                                M
  515. *   PObjParams:    To create a control pointwith.                            M
  516. *                                                                            *
  517. * RETURN VALUE:                                                              M
  518. *   IPObjectStruct *:   A control point object, or NULL if error.            M
  519. *                                                                            *
  520. * KEYWORDS:                                                                  M
  521. *   InptEvalCtlPtFromParams                                                  M
  522. *****************************************************************************/
  523. IPObjectStruct *InptEvalCtlPtFromParams(ParseTree *PObjParams)
  524. {
  525.     int i, NumPts, NumOfParams, PtType,
  526.     CoordCount = 0;
  527.     ParseTree *Param;
  528.     IPObjectStruct *PObj;
  529.  
  530.     NumOfParams = InptEvalCountNumParameters(PObjParams);
  531.  
  532.     PObj = IPAllocObject("", IP_OBJ_CTLPT, NULL);
  533.  
  534.     for (i = 0; i < NumOfParams; i++) {
  535.     if ((Param = InptPrsrEvalTree(InptEvalFetchParameter(PObjParams, i,
  536.                                  NumOfParams),
  537.                       1)) == NULL) {
  538.         IPFreeObject(PObj);
  539.         return NULL;
  540.         }
  541.         if (!IP_IS_NUM_OBJ(Param -> PObj)) {
  542.         IPGlblEvalError = IE_ERR_TYPE_MISMATCH;
  543.         strcpy(IPGlblCharData, "Numeric data expected");
  544.         IPFreeObject(PObj);
  545.         return NULL;
  546.         }
  547.  
  548.     if (i == 0) {
  549.         PtType = PObj -> U.CtlPt.PtType =
  550.             (CagdPointType) Param -> PObj -> U.R;
  551.         switch (PtType) {
  552.         case CAGD_PT_E1_TYPE:
  553.         case CAGD_PT_E2_TYPE:
  554.         case CAGD_PT_E3_TYPE:
  555.         case CAGD_PT_E4_TYPE:
  556.         case CAGD_PT_E5_TYPE:
  557.             NumPts = CAGD_NUM_OF_PT_COORD(PtType);
  558.             CoordCount = 1;
  559.             break;
  560.         case CAGD_PT_P1_TYPE:
  561.         case CAGD_PT_P2_TYPE:
  562.         case CAGD_PT_P3_TYPE:
  563.         case CAGD_PT_P4_TYPE:
  564.         case CAGD_PT_P5_TYPE:
  565.             NumPts = CAGD_NUM_OF_PT_COORD(PtType) + 1;
  566.             CoordCount = 0;
  567.             break;
  568.         default:
  569.             IPGlblEvalError = IE_ERR_TYPE_MISMATCH;
  570.             strcpy(IPGlblCharData,
  571.                "E{1-5} or P{1-5} point type expected");
  572.             IPFreeObject(PObj);
  573.             return NULL;
  574.         }
  575.         if (NumOfParams - 1 != NumPts) {
  576.         IPGlblEvalError = IE_ERR_NUM_PRM_MISMATCH;
  577.         sprintf(IPGlblCharData, "%d expected", NumPts);
  578.         IPFreeObject(PObj);
  579.         return NULL;
  580.         }
  581.     }
  582.         else
  583.         PObj -> U.CtlPt.Coords[CoordCount++] = Param -> PObj -> U.R;
  584.     }
  585.  
  586.     return PObj;
  587. }
  588.  
  589. /*****************************************************************************
  590. * DESCRIPTION:                                                               *
  591. * Fetches the i'th expression out of a tree represent n expressions          *
  592. * (0 <= i < n) seperated by colon. Similar to InptEvalFetchParameter rtn.    *
  593. *                                                                            *
  594. * PARAMETERS:                                                                *
  595. *   Root:      To fetch an expression from.                                  *
  596. *   i:         The expression to fetch.                                      *
  597. *   n:         Total number of expressions.                                  *
  598. *                                                                            *
  599. * RETURN VALUE:                                                              *
  600. *   ParseTree *:   Fetched expression.                                       *
  601. *****************************************************************************/
  602. static ParseTree *InptEvalFetchExpression(ParseTree *Root, int i, int n)
  603. {
  604.     int j;
  605.  
  606.     for (j = 0; j < i; j++)
  607.     Root = Root -> Right;
  608.  
  609.     if (i == n - 1)
  610.         return Root;
  611.     else
  612.     return Root -> Left;
  613. }
  614.  
  615. /*****************************************************************************
  616. * DESCRIPTION:                                                               *
  617. * Count the number of expressions seperated by a COLON that are given in the *
  618. * tree ROOT. This routine is similar to InptEvalCountNumParameters.          *
  619. *                                                                            *
  620. * PARAMETERS:                                                                *
  621. *   Root:      To count number of expressions.                               *
  622. *                                                                            *
  623. * RETURN VALUE:                                                              *
  624. *   int:       Number of expressions found.                                  *
  625. *****************************************************************************/
  626. static int InptEvalCountNumExpressions(ParseTree *Root)
  627. {
  628.     int i = 1;
  629.  
  630.     while (Root -> NodeKind == COLON) {
  631.     i++;
  632.     Root = Root -> Right;
  633.     }
  634.     return i;
  635. }
  636.  
  637. /*****************************************************************************
  638. * DESCRIPTION:                                                               M
  639. * Handles a user defined function or procedure.                           M
  640. *   A user defined function or proecdure is of the sepcial form:         M
  641. *                                         M
  642. * FuncName = {function | procedure}(Param1, Param2, ... , ParamN):         V
  643. *    LocalVar1: LocalVar2: ... LocalVarN:                     V
  644. *    BodyExpr1: BodyExpr2: ... BodYExprN;                     V
  645. *                                         M
  646. * This special form is decomposed into the following sections:             M
  647. * 1. Parameter list as a list of IPObjectStructs.                 M
  648. * 2. Local variable list as a list of IPObjectStructs.                 M
  649. * 3. Body expression list as a Parsing tree.                     M
  650. *                                         M
  651. * Defined function is saved in the global UserDefinedFuncList list.         M
  652. *                                                                            *
  653. * PARAMETERS:                                                                M
  654. *   FuncDef:   Parse tree of user defined function.                          M
  655. *                                                                            *
  656. * RETURN VALUE:                                                              M
  657. *   void                                                                     M
  658. *                                                                            *
  659. * KEYWORDS:                                                                  M
  660. *   InptEvalDefineFunc                                                       M
  661. *****************************************************************************/
  662. void InptEvalDefineFunc(ParseTree *FuncDef)
  663. {
  664.     int NewFunc;
  665.     char
  666.     *Name = FuncDef -> Left -> Left -> PObj -> Name;
  667.     ParseTree *Body, *PTmp;
  668.     UserDefinedFuncDefType *UserFunc;
  669.     IPObjectStruct *PObjTail, *PObj, *PObjTmp;
  670.  
  671.     for (UserFunc = UserDefinedFuncList;
  672.      UserFunc != NULL;
  673.      UserFunc = UserFunc -> Pnext) {
  674.     if (strcmp(UserFunc -> FuncName, Name) == 0) {
  675.         InptEvalDeleteFunc(UserFunc, FALSE);
  676.         break;
  677.     }
  678.     }
  679.     if (UserFunc == NULL) {
  680.     UserFunc = (UserDefinedFuncDefType *)
  681.         IritMalloc(sizeof(UserDefinedFuncDefType));
  682.     UserFunc -> Params = UserFunc -> LocalVars = NULL;
  683.     UserFunc -> Body = NULL;
  684.     UserFunc -> NumParams = 0;
  685.     NewFunc = TRUE;
  686.     }
  687.     else {
  688.     InptEvalDeleteFunc(UserFunc, FALSE);
  689.     NewFunc = FALSE;
  690.     }
  691.  
  692.     /* Mark it as a function or procedure. */
  693.     UserFunc -> IsFunction =
  694.     FuncDef -> Left -> Right -> NodeKind == USERFUNCDEF;
  695.  
  696.     /* Get the function name. */
  697.     PTmp = FuncDef -> Left -> Left;
  698.     strncpy(UserFunc -> FuncName, Name, FUNC_NAME_LEN - 1);
  699.     if (PTmp -> PObj -> ObjType == IP_OBJ_UNDEF) {
  700.     /* Free it since not such object exists. */
  701.     IPFreeObject(PTmp -> PObj);
  702.     PTmp -> PObj = NULL;
  703.     }
  704.  
  705.     /* Remove the object with function name and the return variable if they  */
  706.     /* were undefined and were created because of the parsing of function.   */
  707.     if ((PObj = GetObject(Name)) != NULL && PObj -> ObjType == IP_OBJ_UNDEF)
  708.     DeleteObject(PObj, TRUE);
  709.     if ((PObj = GetObject("RETURN")) != NULL &&
  710.     PObj -> ObjType == IP_OBJ_UNDEF)
  711.     DeleteObject(PObj, TRUE);
  712.  
  713.     /* Save the list of parameters. */
  714.     for (PTmp = FuncDef -> Left -> Right -> Right, PObjTail = NULL;
  715.      PTmp != NULL && PTmp -> NodeKind == COMMA;
  716.      PTmp = PTmp -> Right) {
  717.     if (PTmp -> Left -> NodeKind == PARAMETER) {
  718.         Name = PTmp -> Left -> PObj -> Name;
  719.  
  720.         /* Make sure we do not have duplicated names in param. list. */
  721.         for (PObjTmp = UserFunc -> Params;
  722.          PObjTmp != NULL;
  723.          PObjTmp = PObjTmp -> Pnext) {
  724.         if (strcmp(Name, PObjTmp -> Name) == 0) {
  725.             IPGlblEvalError = IE_ERR_IP_USERFUNC_DUP_VAR;
  726.             sprintf(IPGlblCharData, "Func \"%s\", Variable \"%s\"",
  727.                 UserFunc -> FuncName, Name);
  728.             InptEvalDeleteFunc(UserFunc, TRUE);
  729.             return;
  730.         }
  731.         }
  732.  
  733.         /* Create a new object with same name but undefined type. */
  734.         if (UserFunc -> Params == NULL)
  735.         UserFunc -> Params = PObjTail = 
  736.             IPAllocObject(Name, IP_OBJ_UNDEF, NULL);
  737.         else {
  738.         PObjTail -> Pnext = IPAllocObject(Name, IP_OBJ_UNDEF, NULL);
  739.         PObjTail = PObjTail -> Pnext;
  740.         }
  741.  
  742.         /* Make sure there is no undefined object by that name in global */
  743.         /* list from the parsing stage. If so - remove it.             */
  744.         if ((PObj = GetObject(Name)) != NULL &&
  745.         PObj -> ObjType == IP_OBJ_UNDEF)
  746.         DeleteObject(PObj, TRUE);
  747.     }
  748.     UserFunc -> NumParams++;
  749.     }
  750.     if (PTmp != NULL && PTmp  -> NodeKind == PARAMETER) {
  751.     Name = PTmp -> PObj -> Name;
  752.  
  753.     /* Make sure we do not have duplicated names in param. list. */
  754.     for (PObjTmp = UserFunc -> Params;
  755.          PObjTmp != NULL;
  756.          PObjTmp = PObjTmp -> Pnext) {
  757.         if (strcmp(Name, PObjTmp -> Name) == 0) {
  758.         IPGlblEvalError = IE_ERR_IP_USERFUNC_DUP_VAR;
  759.         sprintf(IPGlblCharData, "Func \"%s\", Variable \"%s\"",
  760.             UserFunc -> FuncName, Name);
  761.         InptEvalDeleteFunc(UserFunc, TRUE);
  762.         return;
  763.         }
  764.     }
  765.  
  766.     /* Create a new object with same name but undefined type. */
  767.     if (UserFunc -> Params == NULL)
  768.         UserFunc -> Params = PObjTail = 
  769.         IPAllocObject(Name, IP_OBJ_UNDEF, NULL);
  770.     else {
  771.         PObjTail -> Pnext = IPAllocObject(Name, IP_OBJ_UNDEF, NULL);
  772.         PObjTail = PObjTail -> Pnext;
  773.     }
  774.  
  775.     /* Make sure there is no undefined object by that name in global     */
  776.     /* list from the parsing stage. If so - remove it.             */
  777.     if ((PObj = GetObject(Name)) != NULL &&
  778.         PObj -> ObjType == IP_OBJ_UNDEF)
  779.         DeleteObject(PObj, TRUE);
  780.  
  781.     UserFunc -> NumParams++;
  782.     }
  783.  
  784.     /* Allocate a "return" variable. */
  785.     UserFunc -> LocalVars = IPAllocObject("RETURN", IP_OBJ_UNDEF, NULL);
  786.  
  787.     /* Isolate the body of the function while saving the list of local vars. */
  788.     for (Body = FuncDef -> Right, PTmp = FuncDef;
  789.      Body -> NodeKind == COLON && Body -> Left -> NodeKind == PARAMETER;
  790.      PTmp = Body, Body = Body -> Right) {
  791.     Name = Body -> Left -> PObj -> Name;
  792.         
  793.     /* Make sure we do not have duplicated names in local vars list. */
  794.     for (PObjTmp = UserFunc -> Params;
  795.          PObjTmp != NULL;
  796.          PObjTmp = PObjTmp -> Pnext) {
  797.         if (strcmp(Name, PObjTmp -> Name) == 0) {
  798.         IPGlblEvalError = IE_ERR_IP_USERFUNC_DUP_VAR;
  799.         sprintf(IPGlblCharData, "Func \"%s\", Variable \"%s\"",
  800.             UserFunc -> FuncName, Name);
  801.         InptEvalDeleteFunc(UserFunc, TRUE);
  802.         return;
  803.         }
  804.     }
  805.     for (PObjTmp = UserFunc -> LocalVars;
  806.          PObjTmp != NULL;
  807.          PObjTmp = PObjTmp -> Pnext) {
  808.         if (strcmp(Name, PObjTmp -> Name) == 0) {
  809.         IPGlblEvalError = IE_ERR_IP_USERFUNC_DUP_VAR;
  810.         sprintf(IPGlblCharData, "Func \"%s\", Variable \"%s\"",
  811.             UserFunc -> FuncName, Name);
  812.         InptEvalDeleteFunc(UserFunc, TRUE);
  813.         return;
  814.         }
  815.     }
  816.  
  817.     /* We found a local variable decl. Copy it to local variable list.  */
  818.     /* Create a new object with same name but undefined type.           */
  819.     UserFunc -> LocalVars =
  820.         IPAllocObject(Name, IP_OBJ_UNDEF, UserFunc -> LocalVars);
  821.  
  822.     /* Make sure there is no undefined object by that name in global     */
  823.     /* list from the parsing stage. If so - remove it.             */
  824.     if ((PObj = GetObject(Name)) != NULL &&
  825.         PObj -> ObjType == IP_OBJ_UNDEF)
  826.         DeleteObject(PObj, TRUE);
  827.     }
  828.  
  829.     /* Disconnect body of the function and save it in function definition.  */
  830.     PTmp -> Right = NULL;
  831.     UserFunc -> Body = Body;
  832.  
  833.     IritPrsrMarkToBeAssigned(Body);
  834.     if (InptPrsrTypeCheck(Body, 0) != ERROR_EXPR) {
  835.     if (NewFunc) {
  836.         UserFunc -> Pnext = UserDefinedFuncList;
  837.         UserDefinedFuncList = UserFunc;
  838.     }
  839.     }
  840.     else
  841.     InptEvalDeleteFunc(UserFunc, TRUE);
  842. }
  843.  
  844. /*****************************************************************************
  845. * DESCRIPTION:                                                               *
  846. * Deletes/clears a user defined function structure.                 *
  847. *                                                                            *
  848. * PARAMETERS:                                                                *
  849. *   UserFunc:    To remove from global list.                                 *
  850. *   DeleteSelf:  If TRUE, free UserFunc as well.                             *
  851. *                                                                            *
  852. * RETURN VALUE:                                                              *
  853. *   void                                                                     *
  854. *****************************************************************************/
  855. static void InptEvalDeleteFunc(UserDefinedFuncDefType *UserFunc,
  856.                    int DeleteSelf)
  857. {
  858.     if (UserFunc -> Params != NULL)
  859.     IPFreeObject(UserFunc -> Params);
  860.     if (UserFunc -> LocalVars != NULL)
  861.     IPFreeObject(UserFunc -> LocalVars);
  862.     if (UserFunc -> Body != NULL)
  863.     InptPrsrFreeTree(UserFunc -> Body);
  864.  
  865.     if (DeleteSelf) {
  866.     if (UserFunc == UserDefinedFuncList)
  867.         UserDefinedFuncList = UserDefinedFuncList->Pnext;
  868.     else if (UserDefinedFuncList != NULL) {
  869.         UserDefinedFuncDefType *TempFunc;
  870.  
  871.         for (TempFunc = UserDefinedFuncList;
  872.          TempFunc -> Pnext != UserFunc && TempFunc -> Pnext != NULL;
  873.          TempFunc = TempFunc -> Pnext);
  874.         if (TempFunc && TempFunc->Pnext == UserFunc)
  875.         TempFunc -> Pnext = TempFunc -> Pnext -> Pnext;
  876.     }
  877.     IritFree((VoidPtr) UserFunc);
  878.     }
  879.     else {
  880.     UserFunc -> Params = UserFunc -> LocalVars = NULL;
  881.     UserFunc -> Body = NULL;
  882.     UserFunc -> NumParams = 0;
  883.     }
  884. }
  885.  
  886. /*****************************************************************************
  887. * DESCRIPTION:                                                               M
  888. * Sets the debug level of user function calls.                     M
  889. *                                                                            *
  890. * PARAMETERS:                                                                M
  891. *   DebugFuncLevel:  Level of debugging user defined functions.              M
  892. *                                                                            *
  893. * RETURN VALUE:                                                              M
  894. *   void                                                                     M
  895. *                                                                            *
  896. * KEYWORDS:                                                                  M
  897. *   InptPrsrDebugFuncLevel                                                   M
  898. *****************************************************************************/
  899. void InptPrsrDebugFuncLevel(int DebugFuncLevel)
  900. {
  901.     GlblDebugFuncLevel = DebugFuncLevel;
  902. }
  903.  
  904. /*****************************************************************************
  905. * DESCRIPTION:                                                               M
  906. * Invokes the evaluation of a user function.                     M
  907. *   The following steps are performed:                         M
  908. * 1. A copy is made of parameter variables and local variables.             M
  909. * 2. Binding of given parameters to function parameters.             M
  910. * 3. The local variables and parameters are added to global variable list.   M
  911. *                                                                            *
  912. * PARAMETERS:                                                                M
  913. *   Root:         Parse tree of user defined function.                       M
  914. *   InputParams:  Parameters of the function.                                M
  915. *                                                                            *
  916. * RETURN VALUE:                                                              M
  917. *   ParseTree *:  Evaluated result.                                          M
  918. *                                                                            *
  919. * KEYWORDS:                                                                  M
  920. *   InptEvalUserFunc                                                         M
  921. *****************************************************************************/
  922. ParseTree *InptEvalUserFunc(ParseTree *Root, ParseTree *InputParams[])
  923. {
  924.     int i;
  925.     char Line[LINE_LEN];
  926.     UserDefinedFuncDefType
  927.     *UserFunc = Root -> UserFunc;
  928.     IPObjectStruct *PObj,
  929.     *RetVal = NULL,
  930.     *LastNewObj = NULL,
  931.     *Params = CopyObjectList(UserFunc -> Params, TRUE),
  932.     *ParamsLast = IritPrsrGetLastObj(Params),
  933.     *LocalVars = CopyObjectList(UserFunc -> LocalVars, TRUE),
  934.     *LocalVarsLast = IritPrsrGetLastObj(LocalVars),
  935.     *EntryGlblObjList = GlblObjList;
  936.     ParseTree
  937.     *Body = InptPrsrCopyTree(UserFunc -> Body);
  938.  
  939.     if (GlblDebugFuncLevel > 0) {
  940.     sprintf(Line, "***** DEBUG FUNC: invoking \"%s\"\n",
  941.         UserFunc -> FuncName);
  942.     WndwInputWindowPutStr(Line);
  943.     }
  944.  
  945.     if (LocalVars) {
  946.     /* Rebind local variables. */
  947.     for (PObj = LocalVars, i = 0; PObj != NULL; PObj = PObj -> Pnext) {
  948.         RebindVariable(Body, PObj, TRUE);
  949.     }
  950.  
  951.     /* Chain the local variables into the global variable list. */
  952.     LastNewObj = LocalVarsLast;
  953.     LocalVarsLast -> Pnext = GlblObjList;
  954.     GlblObjList = LocalVars;
  955.     }
  956.  
  957.     if (Params) {
  958.     /* Copy the parameter data into the parameters and rebind. */
  959.     for (PObj = Params, i = 0; PObj != NULL; PObj = PObj -> Pnext, i++) {
  960.         if (InputParams[i] -> PObj -> ObjType == IP_OBJ_UNDEF) {
  961.         IPGlblEvalError = IE_ERR_IP_OBJ_UNDEFINED;
  962.         sprintf(IPGlblCharData, "%s's parameter %d (%s).",
  963.             UserFunc -> FuncName, i + 1, PObj -> Name);
  964.         return NULL;
  965.         }
  966.         CopyObject(PObj, InputParams[i] -> PObj, FALSE);
  967.         RebindVariable(Body, PObj, TRUE);
  968.  
  969.         if (GlblDebugFuncLevel > 2) {
  970.         sprintf(Line, "***** DEBUG FUNC %s: parameter %d =\n",
  971.             UserFunc -> FuncName, i);
  972.         WndwInputWindowPutStr(Line);
  973.         PrintObject(PObj);        
  974.         }
  975.     }
  976.  
  977.     /* Chain the parameters into the global variable list. */
  978.     if (LastNewObj == NULL)
  979.         LastNewObj = ParamsLast;
  980.     ParamsLast -> Pnext = GlblObjList;
  981.     GlblObjList = Params;
  982.     }
  983.  
  984.     if (GlblDebugFuncLevel > 4) {
  985.     sprintf(Line, "***** DEBUG FUNC %s: global variable list =\n",
  986.         UserFunc -> FuncName);
  987.     WndwInputWindowPutStr(Line);
  988.     PrintObjectList(GlblObjList);        
  989.     }
  990.  
  991.     /* Invoke the body of the function/procedure. */
  992.     InptPrsrEvalTree(Body, 0);
  993.  
  994.     if (strcmp(LocalVarsLast -> Name, "RETURN") != 0)
  995.     IritFatalError("Must have return value as last local\n");
  996.     if (UserFunc -> IsFunction) {
  997.     if (LocalVarsLast -> ObjType == IP_OBJ_UNDEF) {
  998.         IPGlblEvalError = IE_ERR_USER_FUNC_NO_RETVAL;
  999.         strcpy(IPGlblCharData, UserFunc -> FuncName);
  1000.     }
  1001.     else {
  1002.         RetVal = CopyObject(NULL, LocalVarsLast, FALSE);
  1003.  
  1004.         if (GlblDebugFuncLevel > 2) {
  1005.         sprintf(Line, "***** DEBUG FUNC %s: return value =\n",
  1006.             UserFunc -> FuncName);
  1007.         WndwInputWindowPutStr(Line);
  1008.         PrintObject(RetVal);        
  1009.         }
  1010.     }
  1011.     }
  1012.     else {
  1013.     if (GlblDebugFuncLevel > 0) {
  1014.         sprintf(Line, "***** DEBUG FUNC: leaving \"%s\"\n",
  1015.             UserFunc -> FuncName);
  1016.         WndwInputWindowPutStr(Line);
  1017.     }
  1018.     }
  1019.  
  1020.     /* Restore previous state of global var list, and free the local       */
  1021.     /* variables, parameters, and body.                       */
  1022.     LastNewObj ->Pnext = NULL;
  1023.     IPFreeObject(GlblObjList);
  1024.     GlblObjList = EntryGlblObjList;
  1025.     InptPrsrFreeTree(Body);
  1026.  
  1027.     if (RetVal == NULL)
  1028.     return NULL;
  1029.     else {
  1030.     Root -> PObj = RetVal;
  1031.     return Root;
  1032.     }
  1033. }
  1034.